home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Examples / RealIO.p < prev    next >
Text File  |  1989-07-02  |  4KB  |  167 lines
  1. program realnums;
  2.  
  3. {$I ":Include/Math.i"}
  4. {$I ":Include/MathTrans.i"}
  5.  
  6. var
  7.    s : real;
  8.  
  9. {
  10.     Eventually real numbers will be fully supported by PCQ, and
  11. I'll need to write input/output routines for them.  These are an
  12. interim solution.  The example just writes to stdout.  There are also
  13. routines present that read from stdin and read and write from files.
  14. Note that the read from stdin routine actually eats one character
  15. that it shouldn't.  The read-from-file routine doesn't, since it can
  16. access the buffered char.  Once I get these routines into the
  17. lanugage there won't be this problem, of course.
  18.     Be sure to read MathTrans.i before you use it.
  19.  
  20.     Later note: Real numbers are now integrated into the language,
  21. but I left this in....for no reason whatsoever.
  22. }
  23.  
  24. procedure writereal(r : real; i, f : short);
  25.  
  26.     { sorry about the cryptic variable names.  'r' is the number
  27.       to write, 'i' is the field width to the left of the decimal
  28.       point (the integer part), and 'f' is the field width to the
  29.       right of the decimal point (fractional part).  Note that 'i'
  30.       is rudely ignored in this version, since field widths must
  31.       be constant expressions. }
  32.  
  33. var
  34.     t : integer;
  35.     exponent : integer;
  36.     index : integer;
  37. begin
  38.     exponent := 0;
  39.     if spcmp(r, spfloat(100000)) < 0 then begin
  40.     while spcmp(r, spfloat(10)) < 0 do begin
  41.         exponent := exponent + 1;
  42.         r := spdiv(r, spfloat(10));
  43.     end;
  44.     end;
  45.     if sptst(r) < 0 then begin
  46.     r := spabs(r);
  47.     write('-');
  48.     if i > 1 then
  49.         i := i - 1;
  50.     end;
  51.     t := spfix(r);
  52.     r := spsub(r, spfloat(t));
  53.     write(t);
  54.     if f > 0 then begin
  55.     write('.');
  56.     for index := 1 to f do begin
  57.         r := spmul(r, spfloat(10));
  58.         t := spfix(r);
  59.         r := spsub(r, spfloat(t));
  60.         write(chr(t + ord('0')));
  61.     end;
  62.     end;
  63.     if exponent > 0 then
  64.     write('+E', exponent);
  65. end;
  66.  
  67. procedure writerealfile(var filevar : text; r : real; i, f : short);
  68.  
  69.    { read writefile() for an explanation of the variable names.  'i'
  70.      is still ignored. }
  71.  
  72. var
  73.     t : integer;
  74.     exponent : integer;
  75.     index : integer;
  76. begin
  77.     exponent := 0;
  78.     if spcmp(r, spfloat(100000)) < 0 then begin
  79.     while spcmp(r, spfloat(10)) < 0 do begin
  80.         exponent := exponent + 1;
  81.         r := spdiv(r, spfloat(10));
  82.     end;
  83.     end;
  84.     if sptst(r) < 0 then begin
  85.     r := spabs(r);
  86.     write(filevar, '-');
  87.     if i > 1 then
  88.         i := i - 1;
  89.     end;
  90.     t := spfix(r);
  91.     r := spsub(r, spfloat(t));
  92.     write(filevar, t);
  93.     if f > 0 then begin
  94.     write(filevar, '.');
  95.     for index := 1 to f do begin
  96.         r := spmul(r, spfloat(10));
  97.         t := spfix(r);
  98.         r := spsub(r, spfloat(t));
  99.         write(filevar, chr(t + ord('0')));
  100.     end;
  101.     end;
  102.     if exponent > 0 then
  103.     write(filevar, '+E', exponent);
  104. end;
  105.  
  106. procedure readreal(var r : real);
  107. var
  108.     t : integer;
  109.     c : char;
  110.     pow : real;
  111. begin
  112.     read(t);
  113.     r := spfloat(t);
  114.     read(c);
  115.     if c = '.' then begin
  116.     read(c);
  117.     pow := spfloat(10);
  118.     while (c >= '0') and (c <= '9') do begin
  119.         r := spadd(spdiv(spfloat(ord(c) - ord('0')), pow), r);
  120.         pow := spmul(pow, spfloat(10));
  121.         read(c);
  122.     end;
  123.     end;
  124. end;
  125.  
  126. procedure readrealfile(var f : text; var r : real);
  127. var
  128.     t : integer;
  129.     pow : real;
  130. begin
  131.     read(f, t);
  132.     r := spfloat(t);
  133.     if f^ = '.' then begin
  134.     get(f);
  135.     pow := spfloat(10);
  136.     while (f^ >= '0') and (f^ <= '9') do begin
  137.         r := spadd(spdiv(spfloat(ord(f^) - ord('0')), pow), r);
  138.         pow := spmul(pow, spfloat(10));
  139.         get(f);
  140.     end;
  141.     end;
  142. end;
  143.  
  144. begin
  145.     if not OpenMathTrans() then begin
  146.     writeln('Could not open disk-based MathTrans.library');
  147.     exit(20);
  148.     end;
  149.     s := spfloat(0);
  150.     writeln("radians\tsine\tcosine\tlog");
  151.     while spcmp(s, spfloat(7)) > 0 do begin
  152.     writereal(s, 1, 2);
  153.     write(chr(9));
  154.     writereal(spsin(s), 1, 4);
  155.     write(chr(9));
  156.     writereal(spcos(s), 1, 4);
  157.     write(chr(9));
  158.     if spcmp(s, spfloat(0)) = 0 then
  159.         write('Undefined')
  160.     else
  161.         writereal(splog(s), 1, 4);
  162.     writeln;
  163.     s := spadd(s, spdiv(spfloat(1), spfloat(10)));
  164.     end;
  165.     FlushMathTrans;
  166. end.
  167.